home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / acodet1a / formdrag.ctl < prev    next >
Text File  |  1998-06-25  |  13KB  |  327 lines
  1. VERSION 5.00
  2. Begin VB.UserControl FormDragger 
  3.    Alignable       =   -1  'True
  4.    Appearance      =   0  'Flat
  5.    CanGetFocus     =   0   'False
  6.    ClientHeight    =   3600
  7.    ClientLeft      =   0
  8.    ClientTop       =   0
  9.    ClientWidth     =   4800
  10.    ScaleHeight     =   3600
  11.    ScaleWidth      =   4800
  12. End
  13. Attribute VB_Name = "FormDragger"
  14. Attribute VB_GlobalNameSpace = False
  15. Attribute VB_Creatable = True
  16. Attribute VB_PredeclaredId = False
  17. Attribute VB_Exposed = False
  18.  
  19.  
  20. 'API Types
  21. Private Type RECT
  22.     Left As Long
  23.     Top As Long
  24.     Right As Long
  25.     Bottom As Long
  26. End Type
  27.  
  28. Private Type POINTAPI
  29.         X As Long
  30.         Y As Long
  31. End Type
  32.  
  33. 'API Constants
  34. Private Const BDR_SUNKENINNER = &H8
  35. Private Const BF_LEFT As Long = &H1
  36. Private Const BF_TOP As Long = &H2
  37. Private Const BF_RIGHT As Long = &H4
  38. Private Const BF_BOTTOM As Long = &H8
  39. Private Const BF_RECT As Long = (BF_LEFT Or BF_TOP Or BF_RIGHT Or BF_BOTTOM)
  40. Private Const BDR_RAISED = &H5
  41. Private Const GWL_EXSTYLE = (-20)
  42. Private Const WS_EX_TOOLWINDOW = &H80
  43. Private Const VK_LBUTTON = &H1
  44. Private Const PS_SOLID = 0
  45. Private Const R2_NOTXORPEN = 10
  46. Private Const BLACK_PEN = 7
  47. Private Const SM_CYCAPTION = 4
  48.  
  49. 'API Declares
  50. Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
  51. Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  52. Private Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As Long
  53. Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal x1 As Long, ByVal y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
  54. Private Declare Function SetROP2 Lib "gdi32" (ByVal hdc As Long, ByVal nDrawMode As Long) As Long
  55. Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
  56. Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
  57. Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
  58. Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
  59. Private Declare Function GetCapture Lib "user32" () As Long
  60. Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
  61. Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
  62. Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
  63. Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
  64. Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  65. Private Declare Function DrawEdge Lib "user32" (ByVal hdc As Long, qrc As RECT, ByVal edge As Long, ByVal grfFlags As Long) As Long
  66. Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long
  67. Private Declare Function ReleaseCapture Lib "user32" () As Long
  68. Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As Any) As Long
  69. Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
  70. Private Declare Function SetParent Lib "user32" (ByVal HwndChild As Long, ByVal hWndNewParent As Long) As Long
  71. Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
  72. Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
  73. Private Declare Function GetActiveWindow Lib "user32" () As Long
  74.  
  75. 'Event Declarations:
  76. Event Click() 'MappingInfo=UserControl,UserControl,-1,Click
  77. Attribute Click.VB_Description = "Occurs when the user presses and then releases a mouse button over an object."
  78. Attribute Click.VB_MemberFlags = "200"
  79. Event DblClick() 'MappingInfo=UserControl,UserControl,-1,DblClick
  80. Attribute DblClick.VB_Description = "Occurs when the user presses and releases a mouse button and then presses and releases it again over an object."
  81. Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=UserControl,UserControl,-1,MouseDown
  82. Attribute MouseDown.VB_Description = "Occurs when the user presses the mouse button while an object has the focus."
  83. Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=UserControl,UserControl,-1,MouseMove
  84. Attribute MouseMove.VB_Description = "Occurs when the user moves the mouse."
  85. Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=UserControl,UserControl,-1,MouseUp
  86. Attribute MouseUp.VB_Description = "Occurs when the user releases the mouse button while an object has the focus."
  87. Event FormDropped(FormLeft As Long, FormTop As Long, FormWidth As Long, FormHeight As Long)
  88. Event FormMoved(FormLeft As Long, FormTop As Long, FormWidth As Long, FormHeight As Long)
  89.  
  90. 'Default Property Values:
  91. Const m_def_RepositionForm = True
  92. Const m_def_Caption = ""
  93.  
  94. 'Property Variables:
  95. Dim m_RepositionForm As Boolean
  96. Dim m_Caption As String
  97.  
  98. Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  99.     
  100.     Dim na As Long
  101.     Dim pt As POINTAPI
  102.     Dim frmHwnd As Long
  103.     
  104.     UserControl_Paint
  105.     frmHwnd = UserControl.Extender.Parent.hwnd
  106.     
  107.     'start 'dragging' the form
  108.     If Button = vbLeftButton And X >= 0 And X <= UserControl.ScaleWidth And Y >= 0 And Y <= UserControl.ScaleHeight Then
  109.         ReleaseCapture
  110.         DragObject frmHwnd
  111.     End If
  112.  
  113.     RaiseEvent MouseDown(Button, Shift, X, Y)
  114.  
  115. End Sub
  116.  
  117. Private Sub DragObject(ByVal hwnd As Long)
  118.  
  119.     'Procedure which simulates windows dragging of an object.
  120.     
  121.     Dim pt As POINTAPI
  122.     Dim ptPrev As POINTAPI
  123.     Dim objRect As RECT
  124.     Dim DragRect As RECT
  125.     Dim na As Long
  126.     Dim lBorderWidth As Long
  127.     Dim lObjWidth As Long
  128.     Dim lObjHeight As Long
  129.     Dim lXOffset As Long
  130.     Dim lYOffset As Long
  131.     Dim bMoved As Boolean
  132.     
  133.     ReleaseCapture
  134.     GetWindowRect hwnd, objRect
  135.     lObjWidth = objRect.Right - objRect.Left
  136.     lObjHeight = objRect.Bottom - objRect.Top
  137.     GetCursorPos pt
  138.     'Store the initial cursor position
  139.     ptPrev.X = pt.X
  140.     ptPrev.Y = pt.Y
  141.     
  142.     'Set the initial rectangle, and draw it to show the user that
  143.     'the object can be moved
  144.  
  145.     lXOffset = pt.X - objRect.Left
  146.     lYOffset = pt.Y - objRect.Top
  147.     
  148.     With DragRect
  149.         .Left = pt.X - lXOffset
  150.         .Top = pt.Y - lYOffset
  151.         .Right = .Left + lObjWidth
  152.         .Bottom = .Top + lObjHeight
  153.     End With
  154.     'use form border width highlighting
  155.     lBorderWidth = 3
  156.     DrawDragRectangle DragRect.Left, DragRect.Top, DragRect.Right, DragRect.Bottom, lBorderWidth
  157.     'Move the object
  158.     Do While GetKeyState(VK_LBUTTON) < 0
  159.         GetCursorPos pt
  160.         If pt.X <> ptPrev.X Or pt.Y <> ptPrev.Y Then
  161.             ptPrev.X = pt.X
  162.             ptPrev.Y = pt.Y
  163.             'erase the previous drag rectangle if any
  164.             DrawDragRectangle DragRect.Left, DragRect.Top, DragRect.Right, DragRect.Bottom, lBorderWidth
  165.             'Tell the user we've moved
  166.             RaiseEvent FormMoved(pt.X - lXOffset, pt.Y - lYOffset, lObjWidth, lObjHeight)
  167.             'Adjust the height/width
  168.             With DragRect
  169.                 .Left = pt.X - lXOffset
  170.                 .Top = pt.Y - lYOffset
  171.                 .Right = .Left + lObjWidth
  172.                 .Bottom = .Top + lObjHeight
  173.             End With
  174.             DrawDragRectangle DragRect.Left, DragRect.Top, DragRect.Right, DragRect.Bottom, lBorderWidth
  175.             bMoved = True
  176.         End If
  177.         DoEvents
  178.     Loop
  179.     'erase the previous drag rectangle if any
  180.     DrawDragRectangle DragRect.Left, DragRect.Top, DragRect.Right, DragRect.Bottom, lBorderWidth
  181.     'move and repaint the window
  182.     If bMoved Then
  183.         If m_RepositionForm Then
  184.             MoveWindow hwnd, DragRect.Left, DragRect.Top, DragRect.Right - DragRect.Left, DragRect.Bottom - DragRect.Top, True
  185.         End If
  186.         'tell the